home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / CHGE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  14KB  |  336 lines
  1. program chge;
  2.  
  3.  { Copyright 1990 Trevor J Carlsen Version 1.06  24-07-90                    }
  4.  { This program may be used and distributed as if it was in the Public Domain}
  5.  { with the following exceptions:                                            }
  6.  {    1.  If you alter it in any way, the copyright notice must not be       }
  7.  {        changed.                                                           }
  8.  {    2.  If you use code excerpts in your own programs, due credit must be  }
  9.  {        given, along with a copyright notice -                             }
  10.  {        "Parts Copyright 1990 Trevor J Carlsen"                            }
  11.  {    3.  No charge may be made for any program using code from this program.} 
  12.  
  13.   { Changes (or deletes) a string in any file. If an .EXE or .COM file then  }
  14.   { the change must be of a similar length inorder to retain the executable  }
  15.   { integrity.                                                               }
  16.     
  17.   { If you find this program useful here is the author's contact address -   }          
  18.          
  19.   {      Trevor J Carlsen                                                    }          
  20.   {      PO Box 568                                                          }          
  21.   {      Port Hedland Western Australia 6721                                 }          
  22.   {      Voice 61 [0]91 72 2026                                              }          
  23.   {      Data  61 [0]91 72 2569                                              }          
  24.  
  25. uses
  26.   tpstring,                  { from Turbo Power's Turbo Professional Toolbox }
  27.   dos;
  28.  
  29. const
  30.   space       = #32;
  31.   quote       = #34;
  32.   comma       = #44;
  33.   copyright1  = 'CHGE - version 1.06 Copyright 1989,1990 Trevor Carlsen';
  34.   copyright2  = 'All rights reserved.';
  35.  
  36. var
  37.   dirinfo     : SearchRec; { dos }
  38.   f           : file;
  39.   FDir        : DirStr;    { dos }
  40.   mask,
  41.   fname,
  42.   oldstr,
  43.   newstr      : string;
  44.   oldlen      : byte absolute oldstr;
  45.   newlen      : byte absolute newstr;
  46.   changes     : word;
  47.   time        : longint absolute $0000:$046C;
  48.   start       : longint;
  49.  
  50. function ElapsedTime(start : longint): real;
  51.   begin
  52.     ElapsedTime := (time - start) / 18.2;
  53.   end; { ElapsedTime }
  54.  
  55. procedure ReportError(e : byte);
  56.   begin
  57.     writeln('CHGE [path]filename searchstr replacementstr|NUL');
  58.     writeln(' eg:  CHGE c:\autoexec.bat "color" "colour"');
  59.     writeln('      CHGE c:\autoexec.bat 12 13,10,13,10,13,10,13,10');
  60.     writeln('      CHGE c:\wp\test.txt "Trevor" NUL');
  61.     writeln;
  62.     writeln('The first example will change every occurrence of the word "color" to "colour"');
  63.     writeln('The second will replace every formfeed character (ascii 12) with 4 sets of');
  64.     writeln('carriage return/linefeed combinations and the third will delete every');
  65.     writeln('occurrence of "Trevor"');
  66.     writeln('The prime requirements are:');
  67.     writeln('  There MUST always be exactly three space delimiters on the command line -');
  68.     writeln('  one between the program name and the filename, one between the filename and');
  69.     writeln('  the search string and another between the search string and the replacement');
  70.     writeln('  string. Any other spaces may ONLY occur between quote characters.');
  71.     writeln('  The program will not permit you to change the length of an .EXE or .COM file,');
  72.     writeln('  therefore the replacement string MUST be the same length as the string');
  73.     writeln('  that it is replacing in these cases.');
  74.     writeln;
  75.     writeln('  If using ascii codes, each ascii character must be separated from another');
  76.     writeln('  by a comma. The same rule applies to spaces as above - three required - no');
  77.     writeln('  more - no less. If just deleting the NUL must not be in quotes.');
  78.     halt(e);
  79.   end; { ReportError }
  80.  
  81. procedure ParseCommandLine;
  82.   var
  83.     parstr,                                      { contains the command line }
  84.     temp      : string;
  85.     len       : byte absolute parstr;           { the length byte for parstr }
  86.     tlen      : byte absolute temp;               { the length byte for temp }
  87.     CommaPos,
  88.     QuotePos,
  89.     SpacePos,
  90.     chval     : byte;
  91.     error     : integer;
  92.     DName     : NameStr;
  93.     DExt      : ExtStr;
  94.  
  95.   function right(var s; n : byte): string;{ Returns the n right portion of s }
  96.     var
  97.       st : string absolute s;
  98.       len: byte absolute s;
  99.     begin
  100.       if n >= len then
  101.         right := st
  102.       else
  103.         right := copy(st,succ(len)-n,n);
  104.     end; { right }
  105.  
  106.   begin
  107.     parstr        := string(ptr(PrefixSeg,$80)^);     { Get the command line }
  108.     if parstr[1]   = space then
  109.       delete(parstr,1,1);               { First character is usually a space }
  110.     SpacePos      := pos(space,parstr);
  111.     if SpacePos    = 0 then                                      { No spaces }
  112.       ReportError(1);
  113.     mask          := StUpCase(copy(parstr,1,pred(SpacePos)));
  114.     FSplit(mask,Fdir,DName,DExt);       { To enable the directory to be kept }
  115.     delete(parstr,1,SpacePos);
  116.     QuotePos      := pos(quote,parstr);
  117.     if QuotePos   <> 0 then begin          { quotes - so must be quoted text }
  118.       if parstr[1] <> quote then               { so first char must be quote }
  119.         ReportError(2);   
  120.       delete(parstr,1,1);                       { get rid of the first quote }
  121.       QuotePos    := pos(quote,parstr);            { and find the next quote }            
  122.       
  123.       if QuotePos  = 0 then                    { no more - so it is an error }
  124.         ReportError(3);
  125.       oldstr    := copy(parstr,1,pred(QuotePos));{ search string now defined }
  126.       if parstr[QuotePos+1] <> space then            { must be space between }
  127.         ReportError(1);
  128.       delete(parstr,1,succ(QuotePos));             { the quotes - else error }
  129.       if parstr[1] <> quote then begin                     { may be a delete }
  130.         tlen      := 3;
  131.         move(parstr[1],temp[1],3);
  132.         if temp <> 'NUL' then                              { is not a delete }
  133.           ReportError(4)                  { must be quote after space or NUL }
  134.         else
  135.           newlen  := 0;               { is a delete - so nul the replacement }
  136.       end
  137.       else begin
  138.         delete(parstr,1,1);                           { get rid of the quote }
  139.         QuotePos   := pos(quote,parstr); { find next quote for end of string }
  140.         if QuotePos = 0 then                            { None? - then error }
  141.           ReportError(5);
  142.         newstr := copy(parstr,1,pred(QuotePos));{ Replacement string defined }
  143.       end;
  144.     end
  145.     else begin                                   { must be using ascii codes }
  146.       oldlen       := 0;
  147.       SpacePos     := pos(space,parstr);     { Find end of search characters }
  148.       if SpacePos   = 0 then                           { No space - so error }
  149.         ReportError(6);
  150.       temp         := copy(parstr,1,SpacePos-1);
  151.       delete(parstr,1,SpacePos);          { get rid of the search characters }
  152.       CommaPos     := pos(comma,temp);                    { find first comma }
  153.       if CommaPos   = 0 then             { No comma - so only one ascii code }
  154.         CommaPos   := succ(tlen);
  155.       repeat                                      { create the search string }
  156.         val(copy(temp,1,CommaPos-1),chval,error); { convert to a numeral and }
  157.         if error <> 0 then                   { if there is an error bomb out }
  158.           ReportError(7);
  159.         inc(oldlen);
  160.         oldstr[oldlen] := char(chval);{ add latest char to the search string }
  161.         delete(temp,1,CommaPos);
  162.         CommaPos   := pos(comma,temp);
  163.         if CommaPos = 0 then
  164.           CommaPos := succ(tlen);
  165.       until tlen = 0;
  166.       newlen       := 0;
  167.       CommaPos     := pos(comma,parstr);
  168.       if CommaPos   = 0 then
  169.         CommaPos   := succ(len);
  170.       repeat                                 { create the replacement string }
  171.         val(copy(parstr,1,pred(CommaPos)),chval,error);
  172.         if error <> 0 then                              { must be ascii code }
  173.           ReportError(8);
  174.         inc(newlen);
  175.         newstr[newlen] := char(chval);
  176.         delete(parstr,1,CommaPos);
  177.         CommaPos   := pos(comma,parstr);
  178.         if CommaPos = 0 then CommaPos := len+1;
  179.       until len = 0;
  180.     end; { else }
  181.     if ((right(mask,3) = 'COM') or (right(mask,3) = 'EXE')) and
  182.       (newlen <> oldlen) then
  183.       ReportError(16);
  184.   end; { ParseCommandLine }
  185.  
  186. function OpenFile(fn : string): boolean;
  187.   begin
  188.     assign(f,fn);
  189.     {$I-} reset(f,1); {$I+}
  190.     OpenFile := IOResult = 0;
  191.   end; { OpenFile }
  192.  
  193. procedure CloseFile;
  194.   begin
  195.     {$I-}
  196.     truncate(f);
  197.     Close(f);
  198.     if IOResult <> 0 then;                          { dummy call to IOResult }
  199.     {$I+}
  200.   end; { CloseFile }
  201.  
  202. procedure ChangeFile(var chge : word);
  203.   const
  204.     bufflen     = 65000;                    { This is the limit for BMSearch }
  205.     searchlen   = bufflen - 1000;      { Allow space for extra characters in }
  206.   type                                              { the replacement string }
  207.     buffer      = array[0..pred(bufflen)] of byte;
  208.     buffptr     = ^buffer;
  209.   var
  210.     table       : BTable;                         { Boyer-Moore search table }
  211.     old,                                             { pointer to old buffer }
  212.     nu          : buffptr;                           { pointer to new buffer }
  213.     count,
  214.     result,
  215.     oldpos,
  216.     newpos      : word;
  217.     oldfpos,
  218.     newfpos     : longint;
  219.     finished    : boolean;
  220.  
  221.   procedure AllocateMemory(var p; size : word);
  222.     var
  223.       buff : pointer absolute p;
  224.     begin
  225.       if MaxAvail >= size then
  226.         GetMem(buff,size)
  227.       else begin
  228.         writeln('Insufficient memory available.');
  229.         halt(10);
  230.       end;
  231.     end; { AllocateMemory }
  232.  
  233.   begin
  234.     oldfpos := 0; newfpos := 0;
  235.     chge := 0;
  236.     AllocateMemory(old,searchlen);
  237.     AllocateMemory(nu,bufflen);      { make room on the heap for the buffers }
  238.     BMMakeTable(oldstr,table);           { Create a Boyer-Moore search table }
  239.     {$I-}
  240.     BlockRead(f,old^,searchlen,result);                    { Fill old buffer }
  241.     oldfpos := FilePos(f);
  242.     {$I+}
  243.     if IOResult <> 0 then begin
  244.       CloseFile; ReportError(11);
  245.     end;
  246.     repeat
  247.       oldpos := 0; newpos := 0; count := 0;
  248.       finished := (result < searchlen); { if buffer<>full then no more reads }
  249.       repeat                              { Do a BM search for search string }
  250.         count := BMSearch(old^[oldpos],result-oldpos,table,oldstr);
  251.         if count = $FFFF then begin   { search string not found so copy rest }
  252.           move(old^[oldpos],nu^[newpos],result-oldpos);   { of buffer to new }
  253.           inc(newpos,result-oldpos);  { buffer and update the buffer markers }
  254.           inc(oldpos,result-oldpos);
  255.         end
  256.         else begin                                     { search string found }
  257.           if count <> 0 then begin       { not at position one in the buffer }
  258.             move(old^[oldpos],nu^[newpos],count);{ transfer everything prior }
  259.             inc(oldpos,count);          { to the search string to new buffer }
  260.             inc(newpos,count);               { and update the buffer markers }
  261.           end;
  262.           move(newstr[1],nu^[newpos],newlen);  { copy the replacement string }
  263.           inc(oldpos,oldl          { to the new buffer and update the buffer }
  264.           inc(newpos,newlen);                                      { markers }
  265.           inc(chge);
  266.         end;
  267.       until oldpos >= result;               { keep going until end of buffer }
  268.       if not finished then begin       { Fill 'er up again for another round }
  269.         {$I-}
  270.         seek(f,oldfpos);
  271.         BlockRead(f,old^,searchlen,result);
  272.         oldfpos := FilePos(f);
  273.         {$I+}
  274.         if IOResult <> 0 then begin
  275.           CloseFile; ReportError(13);
  276.         end; { if IOResult }
  277.       end; { if not finished }
  278.       {$I-}
  279.       seek(f,newfpos);
  280.       BlockWrite(f,nu^,newpos);                   { write new buffer to file }
  281.       newfpos := FilePos(f);
  282.       {$I+}
  283.       if IOResult <> 0 then begin
  284.         CloseFile; ReportError(12);
  285.       end;
  286.     until finished;
  287.     FreeMem(old, searchlen); FreeMem(nu,bufflen);
  288.   end;  { ChangeFiles }
  289.  
  290. procedure Find_and_change_all_files;
  291.   var
  292.     filefound : boolean;
  293.  
  294.   function padstr(ch : char; len : byte): string;
  295.   
  296.     var
  297.       temp : string;
  298.     
  299.     begin
  300.       FillChar(temp[1],len,ch);
  301.       temp[0] := chr(len);
  302.       padstr  := temp;
  303.     end; { padstr }
  304.  
  305.   begin
  306.     filefound := false;
  307.     FindFirst(mask,AnyFile,dirinfo);
  308.     while DosError = 0 do begin
  309.       filefound := true;
  310.       start := time;
  311.       fname := FDir + dirinfo.name;
  312.       if OpenFile(fname) then begin
  313.         write(fname,PadStr(space,30-length(fname)),FileSize(f):7,'  ');
  314.         ChangeFile(changes);
  315.         CloseFile;
  316.         if changes = 0 then
  317.           writeln
  318.         else
  319.           writeln('Made ',changes,' changes in ',ElapsedTime(start):4:2,' seconds.')
  320.       end
  321.       else
  322.         writeln('Unable to process ',fname);
  323.       FindNext(dirinfo);
  324.     end; { while DosError = 0 }
  325.     if not filefound then
  326.       writeln('No files found.');
  327.   end; { Find_and_change_all_files }
  328.  
  329. begin { main }
  330.   writeln(copyright1);
  331.   writeln(copyright2);
  332.   ParseCommandLine;
  333.   Find_and_change_all_files;
  334. end.
  335.  
  336.